home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MacTech 1 to 12
/
MacTech-vol-1-12.toast
/
Tools
/
Alpha 6.51b13 ƒ
/
Tcl
/
SystemCode
/
calc.tcl
< prev
next >
Wrap
Text File
|
1997-02-18
|
5KB
|
211 lines
##########################################################################
# #
# Use at your own risk. This is just a quick-and-dirty RPN stack #
# calculator, works on both decimal (signed and unsigned), hex #
# integers, and floating point. I put it #
# together for my own use, not yours, but feel free to use it as #
# long as you don't complain about what it doesn't do. Improvements, #
# of course, are welcome. #
# #
# Operations: #
# +,-,*,/,|,&,% Top of stack is 'y', next is 'x'. Does x OP y. #
# ~ bitwise NOT #
# ^ x eor y #
# < x << y #
# > x >> y #
# c change y's sign #
# q dup y #
# i swap x and y #
# m switch decimal/hex modes #
# x show current mode #
# h,? help #
# <delete> pop stack #
# <space> enter number #
# #
# The mode indicator indicates whether hex or dec is active. #
# All calculations performed in signed decimal. #
# #
##########################################################################
set tcl_precision 17
proc calculator {} {
global tileLeft tileTop
if {[set ind [lsearch -exact [winNames] {* Calc *}]] >= 0} {
bringToFront {* Calc *}
return
}
new -g $tileLeft $tileTop 200 200 -n {* Calc *}
global winModes
set name [lindex [winNames] 0]
changeMode [set winModes($name) Calc]
catch {setWinInfo -w $name shell 1}
}
lappend modes Calc
set modes [lsort $modes]
ascii 0x2b "binop +" Calc
ascii 0x2d "binop -" Calc
ascii 0x2a "binop *" Calc
ascii 0x2f "binop /" Calc
ascii 0x7c "binop |" Calc
ascii 0x5e "binop ^" Calc
ascii 0x26 "binop &" Calc
ascii 0x25 "binop %" Calc
ascii 0x3e "binop >>" Calc
ascii 0x3c "binop <<" Calc
ascii 0x7e "unaryop ~" Calc
ascii 0x63 "unaryop -" Calc
ascii 0x3f "editMark \"$HOME:Help:Manual\" Calculator -r" Calc
ascii 0x68 "editMark \"$HOME:Help:Manual\" Calculator -r" Calc
ascii 0x71 calcDup Calc
ascii 0x69 calcEx Calc
ascii 0x6d changeCalcMode Calc
ascii 0x78 "calcShow" Calc
ascii 0x20 calcEnter Calc
ascii 0x08 calcDel Calc
set calcMode 3
proc changeCalcMode {} {
global calcMode
goto [maxPos]
if {[getPos]} {
if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
set nums {}
set t ""
foreach n [split [getText 0 [expr [maxPos] - 1]] "\r"] {
lappend nums [calcGet $n]
}
set calcMode [expr ($calcMode + 1) % 4]
foreach n $nums {
append t "[calcPut $n]\r"
}
replaceText 0 [maxPos] $t
} else {
set calcMode [expr ($calcMode + 1) % 4]
}
switch "$calcMode" {
0 {message "Signed decimal" }
1 {message "Unsigned decimal"}
2 {message "Unsigned hexadecimal"}
3 {message "Floating Point"}
}
}
proc calcShow {} {
global calcMode
switch "$calcMode" {
0 {message "Signed decimal" }
1 {message "Unsigned decimal"}
2 {message "Unsigned hexadecimal"}
3 {message "Floating Point"}
}
}
proc calcGet {in} {
global calcMode
switch "$calcMode" {
0 {scan $in "%d" num; return $num}
1 {scan $in "%u" num; return $num}
2 {scan $in "%x" num; return $num}
3 {scan $in "%f" num; return $num}
}
error "Bad hex num '$in'"
}
proc calcPut {in} {
global calcMode
if {$calcMode != 3} {
regexp {[0-9-]+} $in in
}
switch $calcMode {
0 {return [format "%10d" $in]}
1 {return [format "%10u" $in]}
2 {return [format "%10x" $in]}
3 {return [format "%17.6f" $in]}
}
}
proc binop {op} {
global calcMode
goto [maxPos]
if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
set pos [lineStart [getPos]]
set st_y [lineStart [expr $pos - 1]]
set st_x [lineStart [expr $st_y - 1]]
if {$st_y == $st_x} { beep; return}
set res [eval expr [calcGet [getText $st_x $st_y]] $op [calcGet [getText $st_y $pos]]]
replaceText $st_x [maxPos] "[calcPut $res]\r"
}
proc unaryop {op} {
goto [maxPos]
set pos [getPos]
set last [lineStart [expr [getPos] - 1]]
replaceText $last $pos [expr "[calcPut $op[calcGet [getText $last $pos]]]"] "\r"
}
proc calcEx {} {
goto [maxPos]
if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
set pos [lineStart [getPos]]
set st_y [lineStart [expr $pos - 1]]
set st_x [lineStart [expr $st_y - 1]]
if {$st_y == $st_x} { beep; return}
replaceText $st_x [maxPos] "[getText $st_y $pos][getText $st_x $st_y]"
}
proc calcEnter {} {
global calcMode
goto [maxPos]
switch "$calcMode" {
0 {set ex {[0-9-]+$}}
1 {set ex {[0-9]+$}}
2 {set ex {[0-9a-f]+$}}
3 {set ex {[0-9.-]+$}}
}
if {[regexp $ex [getText [lineStart [getPos]] [getPos]] num]} {
set num [calcGet $num]
replaceText [lineStart [getPos]] [getPos] [calcPut $num] "\r"
} else {
beep
beginningOfLine
killLine
}
}
proc calcDel {} {
goto [maxPos]
if {[lookAt [expr [getPos] - 1]] == "\r"} {
deleteText [lineStart [expr [getPos] - 1]] [getPos]
} else {
backSpace
}
}
proc calcDup {} {
goto [maxPos]
if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
set to [lineStart [getPos]]
set from [lineStart [expr $to - 1]]
set t [getText $from $to]
insertText $t
}